home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / crypt / tarchiv / terase.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-27  |  2KB  |  72 lines
  1. Program TErase;
  2.  
  3. Uses Dos,Crt,ASPI,Arc,Toolbox;
  4.  
  5. Const
  6.  Version = '1.0';
  7. Var
  8.  LineStr : String[80];
  9.  TheTape : PASPITape;
  10.  Target  : Byte;
  11.  Result  : Integer;
  12.  DoIt    : Boolean;
  13.  Ch      : Char;
  14.  
  15.  Procedure WaitForTape;
  16.  Var
  17.   A,B,C,D : Word;
  18.   CC      : Word;
  19.  Begin
  20.    CC := 61;
  21.    Repeat
  22.     GetTime (A,B,C,D);
  23.     If CC<>C Then Begin
  24.      TheTape^.TestUnitReady;
  25.      CC := C;
  26.     End;
  27.    Until NOT TheTape^.Status.Error;
  28.  End;
  29.  
  30. Begin
  31.  LineStr[0]:=#80;
  32.  FillChar(LineStr[1],80,196);
  33.  Writeln (' TERSE ',Version,' - tape eraser and conditioner - A. Schiffler, U of S, 1994');
  34.  Write (LineStr);
  35.  If (ParamCount=1) Or (ParamCount=2) Then Begin
  36.   Val (ParamStr(1),Target,Result);
  37.   If Result=0 Then Begin
  38.    New (TheTape,Init(Target));
  39.    Writeln ('Waiting for tape to come online');
  40.    WaitForTape;
  41.    If Upper(ParamStr(2))='UNCOND' Then
  42.     DoIt := True
  43.    Else Begin
  44.     Writeln ('WARNING ! All information on tape will be deleted!');
  45.     Write   ('Proceed with erase ? [y/n] ');
  46.     Ch := #0;
  47.     Repeat
  48.      IF Keypressed Then Ch := Readkey;
  49.     Until Ch<>#0;
  50.     Ch := UpCase(Ch);
  51.     DoIt := (Ch='Y');
  52.     Writeln;
  53.    End;
  54.    If DoIt Then Begin
  55.     Write ('Erasing tape (approx. 25 min/GByte) ...');
  56.     WaitForTape;
  57.     TheTape^.Erase;
  58.     WaitForTape;
  59.     TheTape^.Rewind;
  60.     WaitForTape;
  61.    End;
  62.    Dispose (TheTape,Done);
  63.    Exit;
  64.   End;
  65.  End;
  66.  Writeln ('Usage  : terase <target number> [UNCOND]');
  67.  Writeln ('         The keyword UNCOND is optional and will supress');
  68.  Writeln ('         all saftey input from the user.');
  69. End.
  70.  
  71.  
  72.